Attribute VB_Name = "modODBCGBMicro"
'---------------------------------------------------------------------------------------
'Module     : modODBC
'Date       : 05/18/2004
'Updated    : 02/21/2005
'Author     : Chris Elwell
'Purpose    : This is an example of a CIC integration module. This is for demostration
'           purposes only. You must write the code required to get/writeback data from/to
'           your customer's data source.
'
'           This example uses the FSMSClientTest.mdb. A DSN is setup as FSMSClientTest.
'           Regardless of the integration method, CICs must have a module that contains
'           specific sub routines. All of these subs/functions listed below must exist
'           as they are called from the main program.
'           Public Function GetData(ByVal strKey As String) As Boolean - this routine is
'               called when the Order ID field loses focus. This is where you would code to
'               get order data from a customer and populate the screen fields. You can create
'               and call as many support routines as necessary. Also, this routine should
'               return a boolean True if getting the order data was succesful and a boolean
'               False if it was not.
'           Public Sub WriteReply() - this is called after a successful shipment. A typical
'               use would be to write FXRS reply data back to a customer's system, but can be
'               used for anything that you want to have happen after a pckage is shipped.
'           Public Sub WriteError() - this is called after an error is returned from FXRS.
'           Public Sub WriteDelete(ByVal strTracking As String) - this is called after a
'               package is successfully deleted.
'           Public Sub AfterClose() - this is called after FXRS is closed.
'           Public Sub BeforeClose() - this is called just before an FXRS close transaction
'               is sent.
'Updated:   Public Function BeforeShip() - Return TRUE to continue shipment, False to cancel.
'           Public Sub Initialize() - this is called once on program execution.
'           Public Sub BeforeBatch() - this is called before processing a batch file.
'           Public Sub BeforeBatchShip() - this is called before each individual batch transaction.
'New:       Public Sub AfterAddrLookup() - this is called after cboCustID, cboContact, and cboCompany lose focus
'New:       Public Sub AfterDeptLostFocus() - this is called after cboDept or f38 loses focus.
'
' 2005-04-20, JFW, Added AddDSN for integration database.
' 2006-11-07, JFW, Add order to MPS select to preserve package order
' 2007-07-31, JFW, Per Rick Dingman, warn shipper of previous shipment on this order.
' 2007-07-31, JFW, Per Rick Dingman, change use of address lines.
' 2007-10-23, JFW, Per Rick, no email on service orders.
'
'---------------------------------------------------------------------------------------


' See Project properties for Conditional Compilation
#If GBMicro Then

Option Explicit

Dim m_CNWinsol As ADODB.Connection
Dim m_CNOut As ADODB.Connection
Dim m_CNCommit As ADODB.Connection
Dim m_RS As ADODB.Recordset
Dim intRecordCurrent As Long
Dim m_strLine As String
Dim m_boolShipComplete As Boolean

Dim m_booleanOnce As Boolean

'2/8/05 - API function declaration to add DSN to system used in AddDSN() function.
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal _
   hwndParent As Long, ByVal fRequest As Long, ByVal _
   lpszDriver As String, ByVal lpszAttributes As String) As Long

'+
' 2006-09-20, JFW, From Copernicus FXI
' Declare object(s)
Public g_strCustNo As String        'Hold Customer Number
'Public g_strPONo As String          'Hold Customer PO Number
Public g_strRefNo As String         'Hold Customer Reference Number
Public g_strCountry As String       'Hold shipto Country
Public g_strZip As String           'Holds zip code
Public g_strEmail As String         'Hold Email address
Public g_strEmail2 As String        'Hold Email address
Public g_blnServiceOrder As Boolean 'Flage for email
' 2011-05-06, JFW, Carry this from import to export.
Dim m_strInvoiceSDN As String
'~

   
'---------------------------------------------------------------------------------------
' Procedure : AddDSN
' DateTime  : 2/8/2005
' Purpose   : Adds the FSMSClient v720.3 DSN
' Call from : Form_Load
'---------------------------------------------------------------------------------------
'
Private Function AddDSN() As Boolean
    On Error GoTo EH
    
    Dim ret As Long
    Dim Driver As String
    Dim Attributes As String
    
'    If GetSystemName = "WINXPC9CA96EA3" _
'    Or GetSystemName = "CAN00335113" Then
'        Driver = "Microsoft Access Driver (*.mdb)"
'        Attributes = Attributes & "DBQ=C:\Program Files\FedEx\Integration\Projects\Copernicus\Data\Orders.mdb" & Chr(0)
'    Else
'        Driver = "Microsoft Access Driver (*.mdb)"
'        Attributes = Attributes & "DBQ=" & App.Path & "\FSMSClientTest.mdb" & Chr(0)
'    End If
'    Attributes = Attributes & "DSN=CopernicusFSMS" & Chr(0)
'    Attributes = Attributes & "DESCRIPTION=FSMS Client Copernicus ship data" & Chr(0)
'
'    ret = SQLConfigDataSource(0, 4, Driver, Attributes)
   
    If ret <> 1 Then
        AddDSN = False
    Else
        AddDSN = True
    End If

    Exit Function
EH:
    AddDSN = False

End Function
'


'---------------------------------------------------------------------------------------
' Procedure : AfterAddrLookup()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboCustID, cboContact, or cboCompany loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrLookup()

End Sub
'



' Procedure : AfterAddrVerify()
' DateTime  : 5/12/2006
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             Address Verification. Three possible status codes are passed. See comments
'             below.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrVerify(ByVal intStatusCode As Integer)

    Select Case intStatusCode
        'Address is verfified
        Case 1

        'Soft error
        Case 2

        'Hard error
        Case 3

    End Select

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterAddrVerifyUpdate()
' DateTime  : 9/13/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             an address has been updated on the Ship form.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrVerifyUpdate()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterBatchShip()
' DateTime  : 10/28/2005
' Purpose   : REQUIRED SUB. Called just after a batch transaction has been processed.
'---------------------------------------------------------------------------------------
'
Public Sub AfterBatchShip()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterBatch()
' DateTime  : 4/6/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             a batch shipment has been completed.
'---------------------------------------------------------------------------------------
'
Public Sub AfterBatch()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterClose()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             FXRS Close.
'---------------------------------------------------------------------------------------
'
Public Sub AfterClose()

End Sub
'


' 2007-04-13, JFW, Allow for custom screen display.
Public Sub AfterConnect()

    ' For Manulife, go to customer lookup
    ' Call frmShip.ToggleLookup(True)

End Sub
'

' 2007-04-13, JFW, Allow for custom screen display.
Public Sub AfterDisconnect()

    On Error Resume Next
    
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterLoadServices()
' DateTime  : 5/17/2011
' Purpose   : Remove or add custom services.
' 2011-05-17, JFW, New for Scapa
'---------------------------------------------------------------------------------------
'
Public Sub AfterLoadServices(c1 As ComboBox)

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterDeptLostFocus()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboDept or f38 loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterLostFocus(c1 As Control)

    If c1.name = "f38" Then
        g_clsReg.SetRegistryValue "Carry_f38", frmShip.f38, REG_SZ
    End If
    If c1.name = "f1273" Then
        g_clsReg.SetRegistryValue "Carry_f1273", Left(frmShip.f1273.Text, 2), REG_SZ
    End If
    
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterLocationChange()
' DateTime  : 3/06/2006
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             the shipping Location has been changed on the Ship form.
'---------------------------------------------------------------------------------------
'
Public Sub AfterLocationChange()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterRateQuote()
' DateTime  : 20071106-01
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             a rate quote.
'---------------------------------------------------------------------------------------
'
Public Sub AfterRateQuote()

End Sub
'

' 2012-01-19, JFW, New for UCS.
Public Function AfterScreenChange(f As Form) As Boolean

End Function

' 2011-05-05, JFW, For Scapa
Public Function TDAutoCloseEnabled() As Boolean
    TDAutoCloseEnabled = False
End Function
'


'---------------------------------------------------------------------------------------
' Procedure : BeforeBatch()
' DateTime  : 20070621-01 Changed BeforeBatch to return a boolean
' Purpose   : REQUIRED SUB. Called before an entire batch is processed.
'---------------------------------------------------------------------------------------
'
Public Function BeforeBatch() As Boolean

    BeforeBatch = True

End Function
'


'---------------------------------------------------------------------------------------
' Procedure : BeforeClose()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed before
'             FXRS Close.
'---------------------------------------------------------------------------------------
'
Public Function BeforeClose() As Boolean

    BeforeClose = True
    
End Function
'

' 2012-01-19, JFW, New for UCS.
Public Function BeforeGotFocus(f As Form, c As Control) As Boolean
    On Error GoTo Test
    Exit Function
Test:
    DebugPrint Now & " BeforeGotFocus " & Err.Description
    
End Function
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeShip()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED Function. Modified to Return Boolean which controls whether or not
'             the shipment will continue or be canceled. Return True to continue shipment,
'             False to cancel.
'---------------------------------------------------------------------------------------
'
Public Function BeforeShip() As Boolean
        
    Dim rsPreassign As New ADODB.Recordset
    Dim strQuery As String
    Dim strPreAssignKey As String
    
    BeforeShip = True
    
    ' Global variables are referenced here
    If g_str1 <> "" Then
    ElseIf frmShip.f1.Text <> "" Then
        g_str1 = frmShip.f1.Text
    ElseIf frmShip.cboCustID.Text <> "" Then
        g_str1 = frmShip.cboCustID.Text
    End If
    If g_str1 = "" Then
        MsgBox "Order ID or Customer ID is a required field.", vbApplicationModal + vbSystemModal
        BeforeShip = False
        Exit Function
    End If
    If g_str116 = "" Then
        If IsNumeric(frmShip.f116.Text) Then
            g_str116 = frmShip.f116.Text
        Else
            g_str116 = 1
        End If
    End If
    If g_str1274 = "" Then
        g_str1274 = Left(frmShip.f1274.Text, 2)
    End If
    
    ' GBMicro puts tracking number on doc tab, provided in ship trans, so all preassigned
    'Added 3/2/05 for pre-assign
    strQuery = "SELECT * FROM PreAssign WHERE f1 = '" & g_str1 & "'"
    rsPreassign.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
    strPreAssignKey = g_str1
    
    '2005-05-27, JFW, P&W
    If rsPreassign.EOF And g_str1222 <> "" Then
        rsPreassign.Close
        strQuery = "SELECT * FROM PreAssign WHERE f1 = '" & g_str1222 & "'"
        rsPreassign.Open strQuery, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
        strPreAssignKey = g_str1222
    End If
    
    If g_str1274 = "92" Or g_str1274 = "90" Then
        If Not rsPreassign.EOF Then
            Do Until rsPreassign.EOF
                rsPreassign.MoveNext
            Loop
            rsPreassign.MoveFirst
        End If
        
        If rsPreassign.EOF Then
            Call frmPreAssign.MakePreAssign(strPreAssignKey, CLng(g_str116), "ground")
        Else
            If CLng(g_str116) > rsPreassign.RecordCount Then
                Call frmPreAssign.MakePreAssign(strPreAssignKey, CLng(g_str116) - rsPreassign.RecordCount, "ground")
            End If
        End If
    Else
        If Not rsPreassign.EOF Then
            Do Until rsPreassign.EOF
                rsPreassign.MoveNext
            Loop
            rsPreassign.MoveFirst
        End If
        
        If rsPreassign.EOF Then
            Call frmPreAssign.MakePreAssign(strPreAssignKey, 1, "intl")
        Else
            If rsPreassign.RecordCount < 1 Then
                Call frmPreAssign.MakePreAssign(strPreAssignKey, 1, "intl")
            End If
        End If
    End If
    
    
End Function
'


'---------------------------------------------------------------------------------------
' Procedure : BeforeShipTrans()
' DateTime  : 8/7/2008
' Purpose   : REQUIRED Function. Modified to Return Boolean which controls whether or not
'             the shipment will continue or be canceled. Return True to continue shipment,
'             False to cancel.
'---------------------------------------------------------------------------------------
'
Public Function BeforeShipTrans(ByRef TransString As String) As Boolean
    
    Dim lngMsgBoxResult As VbMsgBoxResult
    BeforeShipTrans = True
    
    ' Test barcode on doctab
    If Left(TransString, 7) = "0,""020""" Then
    If g_str1222 <> "" Then
        TransString = Replace(TransString, "99,""""", "1621,""" & g_str1222 & """99,""""")
    End If
    End If

End Function
'


'---------------------------------------------------------------------------------------
' Procedure : BuildCustomSPLabel()
' DateTime  : 20070620-04
' Purpose   : REQUIRED SUB. Can be used as hook to create custom EPL or ZPL buffer labels
'             for SmartPost.
'---------------------------------------------------------------------------------------
'
Public Function BuildCustomSPLabel(ByVal strLabel As String) As String

    BuildCustomSPLabel = strLabel

End Function
'

Public Function ClearCommodity() As Boolean

End Function
'

Public Function ClearShipScreen() As Boolean

    On Error Resume Next
    
    frmShip.f38 = g_clsReg.GetRegistryValue("Carry_f38", "")
    frmShip.f1273.Text = g_clsReg.GetRegistryValue("Carry_f1273", "")
    
    g_strRefNo = ""
    m_strInvoiceSDN = ""
    
    'debugprintNow
    
End Function


'---------------------------------------------------------------------------------------
' Procedure : Connect()
' DateTime  : 7/5/2004
' Purpose   : Open connection to ODBC test DSN. Instantiate module level recordset.
'---------------------------------------------------------------------------------------
'
Private Function Connect() As Boolean
    On Local Error GoTo Handler
    Dim strDSN As String
    Dim boolSecondTry As Boolean
    
    If m_CNWinsol Is Nothing Then
        Set m_CNWinsol = New ADODB.Connection
    End If
    
    If m_CNWinsol.State <> adStateOpen Then   'if connection is not open then do so
        If (GetSystemName = "WINXPC9CA96EA3" Or GetSystemName = "CAN00335113") Then
            m_CNWinsol.Open "DSN=GBMicro"
            ' Set m_CNWinsol = g_connFSMSClient
        Else
            m_CNWinsol.Open "DSN=WinSol_210;UID=;PWD="
        End If
    End If
    
    If m_CNOut Is Nothing Then
        Set m_CNOut = New ADODB.Connection
    End If
    If m_CNOut.State <> adStateOpen Then   'if connection is not open then do so
        If (GetSystemName = "WINXPC9CA96EA3" Or GetSystemName = "CAN00335113") Then
            m_CNOut.Open "DSN=GBMicro"
            ' Set m_CNOut = g_connFSMSClient
        Else
            m_CNOut.Open "DSN=Writeback;UID=Shipping;PWD=!Sh1pp1ng!"
        End If
    End If
    
    If m_CNCommit Is Nothing Then
        Set m_CNCommit = New ADODB.Connection
    End If
    If m_CNCommit.State <> adStateOpen Then   'if connection is not open then do so
        If GetSystemName = "WINXPC9CA96EA3" _
        Or GetSystemName = "CAN00335113" Then
            m_CNCommit.Open "DSN=GBMicroCommit"
        Else
            m_CNCommit.Open "DSN=COMMIT_TIMES"
        End If
    End If
    
    Set m_RS = New ADODB.Recordset
    
    Connect = True
    
    Exit Function

Handler:
    If Not boolSecondTry Then
        boolSecondTry = True
        If Err.number = -2147467259 Then
            Call AddDSN
            Resume
        End If
    End If
    MsgBox Err.Description, , "modODBC.Connect"
    Call Kill        'kill connection and recordset

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : Kill()
' DateTime  : 7/5/2004
' Purpose   : Close connection and recordset objects and set = to nothing.
'---------------------------------------------------------------------------------------
'
Public Sub Kill()
    On Local Error GoTo Handler
    
    If Not m_RS Is Nothing Then
        If m_RS.State = adStateOpen Then m_RS.Close
    End If
    Set m_RS = Nothing      'kill recordset
    
    If Not m_CNWinsol Is Nothing Then
        If m_CNWinsol.State = adStateOpen Then m_CNWinsol.Close
    End If
    Set m_CNWinsol = Nothing      'kill connection
    
    If Not m_CNOut Is Nothing Then
        If m_CNOut.State = adStateOpen Then m_CNOut.Close
    End If
    Set m_CNOut = Nothing      'kill connection
    
    If Not m_CNCommit Is Nothing Then
        If m_CNCommit.State = adStateOpen Then m_CNCommit.Close
    End If
    Set m_CNCommit = Nothing      'kill connection
    
    Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.Kill"

End Sub
'



'---------------------------------------------------------------------------------------
' Procedure : GetData()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Called from frmShip.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Function GetData(ByVal strKey As String) As Boolean
    On Local Error GoTo Handler
    Dim strSQL As String
    Dim strUserPwd As String    'DSN user and password separated by ','
    Dim strUser As String       'DSN user name
    Dim strPwd As String        'DSN user password
    Dim strData As String
    Dim i As Long
    Dim iMsgBoxResult As VbMsgBoxResult
    Dim colShipped As New Collection
    Dim rsOut As ADODB.Recordset
    
    If Not Connect Then Exit Function   'set conection and recordset
    
    g_strErrorLocation = "Shipped"
    strData = GetDataShipped(strKey)
    If strData <> "" Then
        strData = strData & "Escape/Cancel to quit."
        iMsgBoxResult = MsgBox(strData, vbApplicationModal + vbOKCancel)
        If iMsgBoxResult = vbCancel Then
            frmShip.f1.Text = ""
            frmShip.f1.SetFocus
            Exit Function
        End If
    End If
    strData = ""
        
    If False And GetSystemName = "WINXPC9CA96EA3" Then
        strSQL = "select * from Address"
        strSQL = strSQL & " Where "
        strSQL = strSQL & "f1 = '" & strKey & "' "
    Else
        strSQL = strSQL & "SELECT * FROM Z__Fedex_Frieght_output_Z_OEFDX "
        strSQL = strSQL & "WHERE Z__Fedex_Frieght_output_Z_OEFDX.Sales_Order = " & "'" & strKey & "'"
    End If
    
    'debugprintstrSQL
    
    m_RS.CursorLocation = adUseClient
    m_RS.Open strSQL, m_CNWinsol, adOpenStatic     'run SELECT

    ' Set m_RS.ActiveConnection = Nothing
    ' m_CNWinsol.Close

    If m_RS.BOF And m_RS.EOF Then
        'No records found for that order number
        m_RS.Close
        GetData = False
        Exit Function
    End If
    
    Call DeleteIntlCommodities(strKey)

    strData = ""
    If m_RS.EOF Then
        strData = "No records"
    Else
        For i = 0 To m_RS.Fields.Count - 1
            strData = strData & vbCrLf & m_RS.Fields(i).name & " " & m_RS.Fields(i).Value
        Next i
    End If
    
    strData = "Record count " & m_RS.RecordCount & vbCrLf & strData
    
    Call GetDataToShip(strKey)

    ' Example use of the SetMessage sub
    ' Call SetMessage("Destination state is: " & m_RS!State, 16, vbBlack, True)

    frmShip.f1670.SetFocus
    
    GetData = True
Release:
    Exit Function
Handler:
    MsgBox Err.Description, , "modODBC.GetData"
    Call Kill
    Resume Release
    Resume

End Function
'


'---------------------------------------------------------------------------------------
' Procedure : GetDataCommit
' Purpose   : Test shipping confirmation tables for
'             previous shipments
'---------------------------------------------------------------------------------------
'
Private Sub GetDataCommit(ByVal strKey As String)
    On Local Error GoTo Handler

    ' Declare variables for procedure
    Dim objRecordset As ADODB.Recordset
    Dim strSQL As String
   
    If Not Connect Then Exit Sub   'set conection and recordset

    strKey = QuoteTrim(strKey)

    strSQL = ""
    strSQL = "Select * From `COMMIT`"
    strSQL = strSQL & " Where `POSTAL` = '" & strKey & "'"
     
    Set objRecordset = New ADODB.Recordset
    objRecordset.Open strSQL, m_CNCommit
    
    ' ADODB doesn't give recordcount at first glance
    ' If objRecordset.RecordCount > 0 Then
    If Not objRecordset.BOF Then
        MsgBox "This shipment may have a deferred delivery date.", _
         vbInformation + vbApplicationModal + vbSystemModal, "Shipment delivery"
         strKey = ""
         m_booleanOnce = False
         GoTo Release
         
     ' ElseIf objRecordset.RecordCount = 0 Then  'Check for 4 character Postal code
     Else
        If m_booleanOnce = False Then
            strKey = Left(strKey, 4)
            m_booleanOnce = True    'Don't want it to loop all the time
            Call GetDataCommit(strKey)
        End If
    End If
Release:
    Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.GetDataCommit"
    Call Kill
    Resume Release
    Resume

End Sub


'---------------------------------------------------------------------------------------
' Procedure : GetDataShipped()
' DateTime  : 7/5/2004
' Purpose   : Copernicus integration.  Test shipping confirmation tables for
'             previous shipments
' 2007-07-31, JFW, Per Rick Dingman, warn shipper of previous shipment on this order.
'---------------------------------------------------------------------------------------
'
Private Function GetDataShipped(ByVal strKey As String) As String
    On Local Error GoTo Handler
    Dim strSelect As String
    Dim strData As String
    Dim i As Long
    Dim iMsgBoxResult As VbMsgBoxResult
    Dim colShipped As New Collection
    Dim rsOut As ADODB.Recordset
    
    strData = ""
        
    If Not Connect Then Exit Function   'set conection and recordset
    
    GetDataShipped = strData
    
Release:
    Exit Function
Handler:
    MsgBox Err.Description, , "modODBC.GetDataShipped"
    Call Kill
    Resume Release
    Resume

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : GetData()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Called from frmShip.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Sub GetDataToShip(strKey As String)

    On Local Error GoTo Handler

    Dim strWeight As String
    Dim strCountry As String
    Dim strPhone As String
    Dim strCity As String
    Dim strZip As String
    Dim strState As String
    Dim strRef As String
    Dim strInvoice As String
    Dim i As Long
        
    With frmShip
        
        g_strErrorLocation = "City-Zip-State"
        strCity = QuoteTrim(m_RS.Fields("Ship_To_Address_3").Value & "")
           If strCity = "" Or strCity = " " Then
              strCity = InputBox("CITY is  blank." & vbCrLf & vbCrLf _
                 & "Please enter the correct CITY.", "CITY")
           End If
           
        strZip = m_RS.Fields("Ship_To_Postal_Zip").Value
           If strZip = "" Or strZip = " " Then
              strZip = InputBox(" POSTAL CODE / ZIP is  blank." & vbCrLf & vbCrLf _
                      & "Please enter the correct POSTAL CODE.", "POSTAL CODE")
           End If
           
        strState = m_RS.Fields("Ship_To_Province").Value & ""
           If strState = "" Or strState = " " Then
              strState = InputBox("PROVINCE CODE is  blank." & vbCrLf & vbCrLf _
                         & "Please enter the *2* letter PROVINCE CODE.", "PROVINCE CODE")
           End If
        
        strPhone = Trim(m_RS.Fields("Telephone").Value & "")
           If strPhone = "  " Or strPhone = " " Or strPhone = "" Or strPhone = "NA" Then
              strPhone = "5143337373"
           End If
           
 
        .f11.Text = QuoteTrim(m_RS.Fields("Ship_To_Name").Value & "")
        .f12.Text = QuoteTrim(m_RS.Fields("Customer_Name").Value & "")
        .f13.Text = QuoteTrim(m_RS.Fields("Ship_To_Address_1").Value & "")
        .f14.Text = QuoteTrim(m_RS.Fields("Ship_To_Address_2").Value & "")
        .f15.Text = strCity
        .f17.Text = strZip
        .f16.Text = strState
        .f18.Text = strPhone
        .f50.Text = "CA"
        
        
        '** WEIGHT and PIECE COUNT
        .f116.Text = 1
        If frmSetup.chkScaleConnected = 1 Then
            .f1670.Text = ReadScale(Right(frmSetup.cmbScalePort, 1), Left(frmSetup.cboProtocol, 1))
        Else
            .f1670.Text = 1
        End If
                '        strWeight = Cafe1.GetScaleWeight
                '        If strWeight = "" Then
                '            strWeight = "1"
                '        End If
                '        frmWgtPkg.txtWgt = strWeight
                '        frmWgtPkg.txtPkg = "1"
                '        Breathe
                '        frmWgtPkg.Show
                '        frmWgtPkg.txtPkg.SetFocus
                '        .Count = frmWgtPkg.txtPkg
                '        .Weight = frmWgtPkg.txtWgt
        '** WEIGHT and PIECE COUNT
         
        .f1274.Text = "01"
        .f75.Text = "LBS"
        .f1273.Text = g_clsReg.GetRegistryValue("Carry_f1273", "")
        If .f1273.Text = "" Then .f1273.Text = "01"
        .f25.Text = .f1.Text
        
        ' 2011-05-06, JFW, Per Jose.
        ' .f3056.Text = Trim(m_RS.Fields("Customer_Po_No").Value & "")
        ' .f3057.Text = m_RS.Fields("Shipping_Document_No").Value & ""
        .f3056.Text = Trim(m_RS.Fields("Customer_Po_No").Value & "") & " - " & Trim(m_RS.Fields("Shipping_Document_No").Value & "")
        .f3057.Text = m_RS.Fields("Customer").Value & ""
        m_strInvoiceSDN = Trim(m_RS.Fields("Shipping_Document_No").Value & "")
        
        .f1.Text = strKey
 
        Call GetDataValidate(.f1.Text, m_strInvoiceSDN)
                
        ' 2010-02-26, JFW, No longer needed.
        'Validates if ZIP is ODA
'        If strState = "QC" Or strState = "PQ" Or strState = "ON" Then
'            m_booleanOnce = False
'            Call GetDataCommit(strZip)
'        End If

    End With
    
    g_strErrorLocation = "Done"

Release:
    Exit Sub
Handler:
    If Err.number = 13 Then
        Resume Next
    Else
        MsgBox Err.Description & " (ODBC1_SetPackageValues)", vbSystemModal
    End If
    
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.GetDataToShip"
    Call Kill
    Resume Release
    Resume

End Sub
'







'---------------------------------------------------------------------------------------
' Procedure : GetDataCommit
' Purpose   : Test shipping confirmation tables for
'             previous shipments
'---------------------------------------------------------------------------------------
'
Private Sub GetDataValidate(ByVal strRef As String, ByVal strInvoice As String)
    On Local Error GoTo Handler

    ' Declare variables for procedure
    Dim objRecordset As ADODB.Recordset
    Dim objRecordset2 As ADODB.Recordset
    Dim strSQL As String
    Dim strTrkNbr As String
   
    If Not Connect Then Exit Sub   'set conection and recordset

    strRef = QuoteTrim(strRef)
    strInvoice = QuoteTrim(strInvoice)

    strSQL = ""
    strSQL = "Select * From TrackingInfo"
    strSQL = strSQL & " Where Order_No = '" & strRef & "'"
    strSQL = strSQL & " and SDN = '" & strInvoice & "'"
     'InputBox "Test Validate", , strSQL
     
    Set objRecordset2 = New ADODB.Recordset
    objRecordset2.Open strSQL, m_CNOut
    
    ' ADODB doesn't give recordcount at first glance
    ' If objRecordset2.RecordCount > 0 Then
    If Not objRecordset2.BOF Then
        strTrkNbr = objRecordset2.Fields(3).Value
        MsgBox "This shipment may have already been processed." _
            & vbCrLf & vbCrLf & "See Tracking Number:  " & strTrkNbr _
            , vbInformation + vbApplicationModal + vbSystemModal, "Shipment processed"
        strRef = ""
        strInvoice = ""
        GoTo Release
    End If

Release:
    Exit Sub
Handler:
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.GetDataToShip"
    Call Kill
    Resume Release
    Resume

End Sub




'---------------------------------------------------------------------------------------
' Procedure : GetPickupData()
' DateTime  : 1/30/2006
' Purpose   : REQUIRED SUB. Called from frmAddTags.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Function GetPickupData(ByVal strKey As String) As Boolean

    GetPickupData = True

End Function
'

Function ServiceConvBack(ByRef ServiceBack As String)
 
    'Written by Bruce Acomb on 7/7/3.
    'Called from ODBC2.WriteBack.
    'This function converts the CAFE service code
    'to a customer-friendly service code.
    
    On Error GoTo EH
    
    Select Case UCase(ServiceBack)
        Case "1"           'Express
             ServiceConvBack = "EXP"
        Case "3"            'ECONOMY
             ServiceConvBack = "ECO"
        Case "6"            'First Overnight
             ServiceConvBack = "F-1"
        Case "92"           'Ground
             ServiceConvBack = "GRD"
        Case "90"           'Home Delivery Ground
             ServiceConvBack = "GRH"
        Case Else           'Default
             ServiceConvBack = "FDX"

    End Select
    
    Exit Function
EH:
   MsgBox Err.Description, vbSystemModal, "ODBC2.ServiceConvBack"
End Function



Function ServiceConvFunc(ByRef ServiceConv As String)
 
    'This function converts the CAFE service code
    'to a customer-friendly service code.
    
    On Error GoTo EH
    
    Select Case UCase(ServiceConv)
        Case "1"           'Express
             ServiceConv = "EXP"
        Case "3"            'ECONOMY
             ServiceConv = "ECO"
        Case "6"            'First Overnight
             ServiceConv = "F-1"
        Case "92"           'Ground
             ServiceConv = "GRD"
        Case "90"           'Home Delivery Ground
             ServiceConv = "GRH"
        Case Else           'Default
             ServiceConv = "EXP"
    End Select
    
    Exit Function
EH:
   MsgBox Err.Description, vbSystemModal, "ODBC1.ServiceConv"
End Function

'---------------------------------------------------------------------------------------
' Procedure : WriteBatchEditReply()
' DateTime  : 1/17/2006
' Purpose   : REQUIRED SUB. Called after a successful Batch Error Edit transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteBatchEditReply()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteBOLReply()
' DateTime  : 1/11/2006
' Purpose   : REQUIRED SUB. Called after a successful FedEx Freight BOL transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteBOLReply()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteCancelTagReply()
' DateTime  : 1/26/2006
' Purpose   : REQUIRED SUB. Called after a successful Cancel Call Tag/Express Tag transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteCancelTagReply()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteReply()
' DateTime  : 2/14/2005
' Purpose   : REQUIRED SUB. Called after a successful ship transaction.
'             This example shows how to obtain multiple occurrence fields from the
'             FXRS reply and how to obtain multiple occurrence fields included in the
'             input transaction but not returned in the FXRS reply.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReply()
    
    On Local Error GoTo Handler
    
    ' Declare variables for procedure
    Dim strSQL As String
    
    Dim i As Integer
    Dim j As Integer
    
    Dim f1 As String                    'OrderID (in TransID field)
    Dim f34 As String                   'Base charge
    Dim f35 As String                   'Total surcharges
    Dim f36 As String                   'Total discount
    Dim f37 As String                   'Net charge
    Dim f60 As String                   'Billed weight
    Dim f116 As String                  'Num pkgs
    Dim f1393 As String                 'Total fuel
    Dim strInsert As String             'SQL INSERT
    Dim strMPS As String                'MPS SELECT query
    Dim rsMPS As New ADODB.Recordset    'Used to capture MPS input fields
    
    'Declare string arrays for trk#s and declared values
    Dim str29() As String
    Dim str26() As String
    
    Dim intNumPkgs As Integer

    ' Declare variables for sql statement
    Dim strWriteback As String
    Dim strTrackNO As String
    Dim strMasterNo As String
    Dim strRef As String
    Dim strNetCharge As String
    Dim strGST As String
    Dim strPST As String
    Dim strHST As String
    Dim strShipDate As String
    Dim strService As String
    Dim strCount As String
    Dim strWeight As String
    Dim strChrBeforeTax As String
    Dim strCurrentDate As String
    Dim strValid As String
    Dim strFedEx As String
    Dim strShipID As String
    Dim strTrackDefaultNO As String
    Dim strDay As String
    Dim vbResultWed As VbMsgBoxResult
    
    Dim dblNetCharge As Double
    Dim dblGST As Double
    Dim dblPST As Double
    Dim dblHST As Double
    Dim dblChargeBeforeTax As Double

    g_strErrorLocation = "Connect"
    
    ' Validate Connection object
    If Not Connect Then Exit Sub
    
    strDay = Format(Now, "MM/DD/YY hh:mm")
    
    'Get # of pkgs
    g_strErrorLocation = "116"
    intNumPkgs = Val(g_str116)
    
    'ReDim the string array using the # of pkgs
    ReDim str29(intNumPkgs)
    ReDim str26(intNumPkgs)
    
    'Get the fields you wish from the reply transaction
    g_strErrorLocation = "Parser"
    With frmShip.g_clsParser
        For i = 0 To .TotalFields - 1
            Select Case .Field(i)
                Case "1"
                    f1 = .Data(i)           'TransID
                Case "29"
                    str29(0) = .Data(i)     'First trk#
                Case "34"
                    f34 = .Data(i)          'Base charge
                Case "35"
                    f35 = .Data(i)          'Total Surcharges
                Case "36"
                    f36 = .Data(i)          'Total Discount
                Case "37"
                    f37 = .Data(i)          'Net Charges
                Case "60"
                    f60 = .Data(i)          'Billed Weight
                Case "116"
                    f116 = .Data(i)         '# Pkgs
                Case "1393"
                    f1393 = .Data(i)        'Fuel
            End Select
            
            'Get multiple occurrence tracking #s
            'Note: This will capture Int'l MPS child trk#s as well as domestic MPS
            If intNumPkgs > 1 And frmShip.chkDuplicate = 0 Then
                For j = 2 To intNumPkgs
                    If .Field(i) = "29-" & Trim(Str(j)) Then str29(j) = .Data(i)
                Next
            End If
        Next
    End With
    
    g_strErrorLocation = "MPS"
    'Query to get fields saved in MPS table for MPS transactions
    ' 2006-11-07, JFW, Add order to MPS select to preserve package order
    strMPS = "SELECT * FROM MPS WHERE f1 = '" & f1 & "' order by ShipDate"
    DebugPrint "FSMSClient, GBMicro, WriteReply, MPS query (" & strWriteback & ")"
    
    'Open recordset
    rsMPS.Open strMPS, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
    
    'Loop through the MPS recordset and assign the Declared Value fields
    'Note: You can also capture any other MPS field using this loop by declaring
    'variables for those data element assigning the values here.
    g_strErrorLocation = "DV"
    i = 1
    If Not rsMPS.EOF Then
        Do Until rsMPS.EOF
            str26(i) = rsMPS!g_str26 & ""
            rsMPS.MoveNext
            i = i + 1
        Loop
    Else
        str26(0) = g_str26
    End If
    
    'Perform Insert query for each package
    g_strErrorLocation = "NumPkgs"
    For i = 0 To intNumPkgs - 1
        
        If str29(i) <> "" Then
        
            If Not IsNumeric(g_str1670) Then
                g_str1670 = 1
            End If
            
            ' Set return values
            strTrackNO = str29(0)
            strMasterNo = str29(i)
            strRef = g_str25
            dblNetCharge = IIf(IsNumeric(g_str37), g_str37, 0)
            dblGST = 0
            dblPST = 0
            dblHST = 0
            strShipDate = Format(CDate(g_str24) + Time, "MM/DD/YY hh:mm")
            strDay = UCase(Format(CDate(g_str24), "DDD"))
            strService = g_str1274
            strCount = IIf(IsNumeric(g_str116), Val(g_str116), 1)
            strWeight = IIf(IsNumeric(g_str1670), Val(g_str1670), 100)
            strShipID = ""
            ' strInvoiceSDN = g_str3057
                
            g_strErrorLocation = "SQL insert"
            If strTrackNO = strMasterNo Then
            
               dblChargeBeforeTax = IIf(IsNumeric(f34), Val(f34), 0) - IIf(IsNumeric(f36), Val(f36), 0) + IIf(IsNumeric(f1393), Val(f1393), 0)
    
               'Convert Service
               strService = ServiceConvBack(strService)
           
               strChrBeforeTax = CStr(dblChargeBeforeTax / 100)
               strCurrentDate = "Shipped " & Format(Now, "MM/DD/YY hh:mm")
               strValid = "Y"
               strFedEx = "FedEx"
               strTrackDefaultNO = "1"
        
                ' Set SQL statement
                strWriteback = "INSERT INTO TrackingInfo ( Order_No, Tracking, [Date], Nb_boxes,  "
                strWriteback = strWriteback & "Total_weight, Service_used, Shipping_Cost, Status, Valid_record, shipper_name, SDN, Tracking_No )"
                strWriteback = strWriteback & " Values ( "
                ' Order_No in f1
                ' strWriteback = strWriteback & "'" & strShipID & "', "
                strWriteback = strWriteback & "'" & f1 & "', "
                strWriteback = strWriteback & "'" & strMasterNo & "', "
                strWriteback = strWriteback & "'" & strShipDate & "', "
                strWriteback = strWriteback & "'" & strCount & "', "
                strWriteback = strWriteback & "'" & strWeight & "', "
                strWriteback = strWriteback & "'" & strService & "', "
                strWriteback = strWriteback & "'" & strChrBeforeTax & "', "
                strWriteback = strWriteback & "'" & strCurrentDate & "', "
                strWriteback = strWriteback & "'" & strValid & "', "
                strWriteback = strWriteback & "'" & strFedEx & "', "
                strWriteback = strWriteback & "'" & m_strInvoiceSDN & "', "
                strWriteback = strWriteback & "'" & strTrackDefaultNO & "' )"
                
                DebugPrint "FSMSClient, GBMicro, WriteReply, insert SQL (" & strWriteback & ")"
                
                'Execute SQL statement
                 m_CNOut.Execute strWriteback
            End If
            
        End If ' str29
        
    Next i
    
    m_strInvoiceSDN = ""
    g_strRefNo = ""
    g_strErrorLocation = "Done"
    
Release:
    ' call kill
    If rsMPS.State = adStateOpen Then rsMPS.Close
    Set rsMPS = Nothing
    Exit Sub

Handler:
    DebugPrint "FSMSClient, GBMicro, WriteReply, Error at " & g_strErrorLocation & " - " & Err.Description
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.WriteReply"
    Call Kill
    Resume Release
    Resume
    
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteError()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             an FXRS Error reply transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteError()
    MsgBox "Shipping Error: " & g_str3, vbCritical, "FSMS Error"
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteDelete()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             successful FXRS Delete.
'---------------------------------------------------------------------------------------
'
Public Sub WriteDelete(ByVal strTracking As String)
'Called:    frmShip Parsecomplete event on FSMS 123 reply
'Purpose:   update customer table on void
    On Local Error GoTo Handler
    
    ' Declare variables for procedure
    Dim strSQL As String
    ' Declare variables for procedure
    Dim strWriteback  As String
    Dim lngErr As Long
    Dim strIndexVal As String
    Dim strDate As String

    ' Validate Connection state
    If Not Connect Then Exit Sub

    ' Validate * is compliant with inline error handling
    On Error Resume Next
    
    strDate = Format(Now, "MM/DD/YY hh:mm")
 
    ' Validate Connection object
    If Not Connect Then Exit Sub
 
    ' Set SQL statement
    strWriteback = "Delete from dbo.TrackingInfo"
    strWriteback = strWriteback & " WHERE " & "Tracking "
    strWriteback = strWriteback & " = '" & strTracking & "'"
    'InputBox "Test Delete", , strWriteback
        
    'Execute SQL statement
    m_CNOut.Execute strWriteback
    
Release:
   ' call kill
   Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.WriteDelete"
    Call Kill
    Resume Release
    
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteReturnDelete()
' DateTime  : 7/14/2005
' Purpose   : REQUIRED SUB. Called after a successful return label delete transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReturnDelete(ByVal strTracking As String)

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteReturnReply()
' DateTime  : 7/14/2005
' Purpose   : REQUIRED SUB. Called after a successful return label transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReturnReply()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteTagReply()
' DateTime  : 1/26/2006
' Purpose   : REQUIRED SUB. Called after a successful Call Tag/Express Tag transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteTagReply()

End Sub
'



'---------------------------------------------------------------------------------------
' Procedure : Initialize()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed on
'             program execution.
'---------------------------------------------------------------------------------------
'
Public Sub Initialize(Optional f1 As Form)

    If Not f1 Is Nothing Then
        If f1.name = "frmShip" Then
            frmShip.f38 = g_clsReg.GetRegistryValue("Carry_f38", "")
            frmShip.f1273.Text = g_clsReg.GetRegistryValue("Carry_f1273", "")
        End If
    End If
    
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : BeforeBatchShip()
' DateTime  : 8/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed on
'             program execution. Called just before a batch transaction is sent to the server.
'---------------------------------------------------------------------------------------
'
Public Function BeforeBatchShip() As Boolean

    BeforeBatchShip = True
    
End Function
'


#End If


